Carousel/CAROUSEL.cdr/mactosh/utilprn/hpdeskje.sit/HPDJet ƒ/PRER_Builder.Pas

Pascal/Delphi Source File | 1989-04-02 | 14.5 KB | 560 lines | [TEXT/TPAS]

{ 02.04.1989  amn  (latest edit) }

{$U-}  {don't automatically include units}

PROGRAM PRER_Builder;

{ A program to build printer resource files from DRVR, PACK, and CODE resources }
{ produced by LightspeedC. }

{ Author(s):  Ari Mujunen ([e-mail]). }
{ Authors:  Ari Mujunen ([e-mail]) and Olli Arnberg ([e-mail]). }
{ Copyright Ari Mujunen, Olli Arnberg 1989. }
{ You may redistribute this program together the HPDJ printer driver }
{ (=printer resource file, source files, documentation file(s),}
{ and the file 'Copyright and Source Offer') }
{ only _non-commercially_ and _in its entirety_. }

{ Change history: }
{ Version  Date        Who  Why }
{ 0.0      17.11.1988  amn  Initial version. }
{          18.11.1988  amn  Use of jump table header when producing PDEF resources. }
{ 1.0      20.11.1988  amn  HomeResFile returns 0 for system file (despite IM I-116). }
{          26.11.1988  amn  Noticed that 'DRVR' 2 '.Print' in System file should not }
{                           be changed.  Name in 'STR ' -8192 suffices. }
{                           Accept files of type 'PRES' (as Imagewriter). }
{          03.02.1989  amn  Setting Chooser package flag bits correctly. }
{          02.04.1989  amn  Copyright notice. }


{$T APPLP*8-}  {File type 'APPL', creator 'P*8-'}
{$R PRER_Builder.Rsrc}  {identify resource file}

USES
  MemTypes,
  QuickDraw,
  OSIntf,
  ToolIntf,
  PackIntf;


  CONST
    { Resource id's: }
    mainDLOGId = 128;
    fileErrorALRTId = 128;
    pdefCodeResourceHeaderHEADId = 128;

    resIdOwnedByPDEF = -8192;
    resIdOwnedByPACK = -4096;

    okButton = 1;
    cancelButton = 2;


  VAR
    applicationResFile: Integer;
    actualSystemResFile: Integer;

    mainDialog: DialogPtr;
    itemHit: Integer;
    whatToDo:
      RECORD
        rFilePrefix: Str255;
        rDrvr: Boolean;
        rPdef0: Boolean;
        rPdef1: Boolean;
        rPdef4: Boolean;
        rPdef5: Boolean;
        rPack: Boolean;
        rInstallToSystem: Boolean;
        rPrinterResourceFile: SFReply;
      END;

    printerResourceFileRefNum: Integer;

    retCode: OSErr;


  PROCEDURE tryToProcessCheckBox(theDialog: DialogPtr; itemNo: Integer);

    VAR
      itemType: Integer;
      item: Handle;
      box: Rect;
      theValue: Integer;

  BEGIN
    GetDItem(theDialog, itemNo, itemType, item, box);
    IF itemType<>(ctrlItem+chkCtrl) THEN
      Exit;
    theValue := GetCtlValue(ControlHandle(item));
    IF theValue<>0 THEN
      theValue := 0
    ELSE
      theValue := 1;
    SetCtlValue(ControlHandle(item), theValue);
  END;  {tryToProcessCheckBox}


  PROCEDURE getTextItem(theDialog: DialogPtr; itemNo: Integer; VAR text: Str255);

    VAR
      itemType: Integer;
      item: Handle;
      box: Rect;

  BEGIN
    GetDItem(theDialog, itemNo, itemType, item, box);
    IF NOT ((itemType=editText) OR (itemType=statText)) THEN
      Exit;
    GetIText(item, text);
  END;  {getTextItem}


  FUNCTION checkButtonState(theDialog: DialogPtr; itemNo: Integer) : Boolean;

    VAR
      itemType: Integer;
      item: Handle;
      box: Rect;

  BEGIN
    GetDItem(theDialog, itemNo, itemType, item, box);
    IF NOT ((itemType=(ctrlItem+chkCtrl))
              OR (itemType=(ctrlItem+radCtrl))
              OR (itemType=(ctrlItem+btnCtrl)))
    THEN
      BEGIN
      checkButtonState := False;
      Exit;
      END;
    checkButtonState := (GetCtlValue(ControlHandle(item)) = 1);
  END;  {checkButtonState}


  PROCEDURE decodeMainDialogState;

    CONST
      cFilePrefix=5;
      cDrvr=7;
      cPdef0=8;
      cPdef1=9;
      cPdef4=10;
      cPdef5=11;
      cPack=12;
      cInstallToSystem=13;

  BEGIN
    WITH whatToDo DO
      BEGIN
        getTextItem(mainDialog, cFilePrefix, rFilePrefix);
        rDrvr := checkButtonState(mainDialog, cDrvr);
        rPdef0 := checkButtonState(mainDialog, cPdef0);
        rPdef1 := checkButtonState(mainDialog, cPdef1);
        rPdef4 := checkButtonState(mainDialog, cPdef4);
        rPdef5 := checkButtonState(mainDialog, cPdef5);
        rPack := checkButtonState(mainDialog, cPack);
        rInstallToSystem := checkButtonState(mainDialog, cInstallToSystem);
      END;  {WITH}
  END;  {decodeMainDialogState}


  FUNCTION determineFile : OSErr;

    VAR
      where: Point;
      dummy: Str255;
      typeList: SFTypeList;

  BEGIN
    where.v := 100;
    where.h := 100;
    typeList[0] := 'PRER';
    typeList[1] := 'PRES';
    SFGetFile(
      where,
      dummy,
      NIL,
      2,
      typeList,
      NIL,
      whatToDo.rPrinterResourceFile
    );
    IF whatToDo.rPrinterResourceFile.good THEN
      determineFile := noErr
    ELSE
      determineFile := bdNamErr;
  END;  {determineFile}


  { HomeResFile returns 0 when the resource is in the System file. }
  { actualHomeResFile returns the actual reference number. }
  FUNCTION actualHomeResFile(h: Handle) : Integer;
    VAR
      refNum: Integer;
  BEGIN
    refNum := HomeResFile(h);
    IF refNum = 0 THEN
      actualHomeResFile := actualSystemResFile
    ELSE
      actualHomeResFile := refNum;
  END;  {actualHomeResFile}


  PROCEDURE fileErrorAlert(theError: OSErr; whichFile: Str255);
    VAR
      resFileRefNum: Integer;
      theErrorAsString: Str255;
  BEGIN
    resFileRefNum := CurResFile;
    UseResFile(applicationResFile);

    NumToString(theError, theErrorAsString);
    ParamText(theErrorAsString, whichFile, '', '');
    IF StopAlert(fileErrorALRTId, NIL) = cancelButton THEN
      ExitToShell;  {escape to Finder}

    UseResFile(resFileRefNum);
  END;  {fileErrorAlert}


  FUNCTION openPrinterResourceFile : OSErr;
    LABEL
      errorLabel;
  BEGIN
    retCode := SetVol(NIL, whatToDo.rPrinterResourceFile.vRefNum);
    IF retCode <> noErr THEN
      GOTO errorLabel;
    printerResourceFileRefNum := OpenResFile(whatToDo.rPrinterResourceFile.fName);
    IF printerResourceFileRefNum = -1 THEN
      BEGIN
      retCode := ResError;
      GOTO errorLabel;
      END;

    openPrinterResourceFile := noErr;
    Exit;

  errorLabel:
    fileErrorAlert(retCode, whatToDo.rPrinterResourceFile.fName);
    openPrinterResourceFile := retCode;
  END;  {openPrinterResourceFile}


  PROCEDURE formFileName(prefix, suffix: Str255; VAR name: Str255);
  BEGIN
    name := prefix + suffix;
  END;  {formFileName}


  FUNCTION getResFromCurrentFile(theType: OSType; theId: Integer) : Handle;
    VAR
      h: Handle;
  BEGIN
    h := GetResource(theType, theId);
    IF h<>NIL THEN
      IF actualHomeResFile(h) <> CurResFile THEN
        BEGIN
        ReleaseResource(h);
        h := NIL;
        END;
    getResFromCurrentFile := h;
  END;  {getResFromCurrentFile}


  FUNCTION replaceResource(
    r: Handle;
    theType: OSType;
    theId: Integer;
    theName: Str255;
    newAttrs: Integer
  ) : OSErr;
    VAR
      oldResource: Handle;
      oldAttrs: Integer;
  BEGIN
    oldResource := GetResource(theType, theId);
    IF oldResource <> NIL THEN
      BEGIN
      IF actualHomeResFile(oldResource) = CurResFile THEN
        BEGIN
        RmveResource(oldResource);
        DisposHandle(oldResource);
        END
      ELSE
        ReleaseResource(oldResource);
      END;

    AddResource(r, theType, theId, theName);
    IF ResError <> noErr THEN
      BEGIN
      replaceResource := ResError;
      Exit;
      END;
    oldAttrs := GetResAttrs(r);
    IF ResError <> noErr THEN
      BEGIN
      replaceResource := ResError;
      Exit;
      END;
    newAttrs := (oldAttrs AND $FF83) OR (newAttrs AND $007C);
    SetResAttrs(r, newAttrs);
    IF ResError <> noErr THEN
      BEGIN
      replaceResource := ResError;
      Exit;
      END;
    replaceResource := noErr;
  END;  {replaceResource}


  PROCEDURE processDrvr(suffix: Str255);
    VAR
      name: Str255;
      sourceFileRefNum: Integer;
      drvrHandle,
      globalVariablesHandle: Handle;
  BEGIN
    formFileName(whatToDo.rFilePrefix, suffix, name);
    sourceFileRefNum := OpenResFile(name);
    IF sourceFileRefNum = -1 THEN
      BEGIN
      fileErrorAlert(ResError, name);
      Exit;
      END;

    drvrHandle := getResFromCurrentFile('DRVR', 2);
    IF drvrHandle=NIL THEN
      BEGIN
      fileErrorAlert(ResError, name);
      Exit;
      END;
    DetachResource(drvrHandle);
    HNoPurge(drvrHandle);

    globalVariablesHandle := getResFromCurrentFile('DATA', -16320);
    IF globalVariablesHandle=NIL THEN
      BEGIN
      fileErrorAlert(ResError, name);
      Exit;
      END;
    DetachResource(globalVariablesHandle);
    HNoPurge(globalVariablesHandle);

    CloseResFile(sourceFileRefNum);
    IF ResError <> noErr THEN
      fileErrorAlert(ResError, name);

    UseResFile(printerResourceFileRefNum);
    retCode := replaceResource(drvrHandle, 'DRVR', resIdOwnedByPDEF, '.XPrint', (resPurgeable));
    IF retCode <> noErr THEN
      fileErrorAlert(retCode, whatToDo.rPrinterResourceFile.fName);
    retCode := replaceResource(globalVariablesHandle, 'PREC', resIdOwnedByPDEF, 'Globals', (0));
    IF retCode <> noErr THEN
      fileErrorAlert(retCode, whatToDo.rPrinterResourceFile.fName);
  END;  {processDrvr}


  PROCEDURE processPdef(suffix: Str255; id:Integer);

    CONST
      ourApplicationFileName='PRER_Builder';  {for error messages only}

    VAR
      name: Str255;
      sourceFileRefNum: Integer;
      pdefHandle: Handle;
      headerHandle: Handle;
      resultHandle: Handle;

  BEGIN
    formFileName(whatToDo.rFilePrefix, suffix, name);
    sourceFileRefNum := OpenResFile(name);
    IF sourceFileRefNum = -1 THEN
      BEGIN
      fileErrorAlert(ResError, name);
      Exit;
      END;

    pdefHandle := getResFromCurrentFile('PDEF', id);
    IF pdefHandle=NIL THEN
      BEGIN
      fileErrorAlert(ResError, name);
      Exit;
      END;
    DetachResource(pdefHandle);
    HNoPurge(pdefHandle);
    CloseResFile(sourceFileRefNum);
    IF ResError <> noErr THEN
      fileErrorAlert(ResError, name);

    UseResFile(printerResourceFileRefNum);

    { Add our jump table header to the beginning of resource. }
    headerHandle := GetResource('HEAD', pdefCodeResourceHeaderHEADId);
    IF headerHandle=NIL THEN
      BEGIN
      fileErrorAlert(ResError, ourApplicationFileName);
      Exit;
      END;

    resultHandle := NewHandle(GetHandleSize(headerHandle) + GetHandleSize(pdefHandle));
    IF resultHandle=NIL THEN
      BEGIN
      fileErrorAlert(ResError, whatToDo.rPrinterResourceFile.fName);
      Exit;
      END;

    BlockMove(headerHandle^, resultHandle^, GetHandleSize(headerHandle));
    BlockMove(
      pdefHandle^,
      Ptr(LongInt(resultHandle^) + GetHandleSize(headerHandle)),
      GetHandleSize(pdefHandle)
    );

    retCode := replaceResource(resultHandle, 'PDEF', id, '', (resPurgeable+resLocked));
    IF retCode <> noErr THEN
      fileErrorAlert(retCode, whatToDo.rPrinterResourceFile.fName);
  END;  {processPdef}


  PROCEDURE processPack(suffix: Str255);
    TYPE
      tCodeResourceHeader=
        RECORD
        rBranchToHex10: Integer;
        rDeviceId: Integer;
        rPACK: OSType;
        rId4096: Integer;
        rVersion: Integer;
        rFlags: LongInt;
        {start of driver code follows}
        END;
      tpCodeResourceHeader= ^tCodeResourceHeader;
      thCodeResourceHeader= ^tpCodeResourceHeader;
    VAR
      name: Str255;
      sourceFileRefNum: Integer;
      r: Handle;
  BEGIN
    formFileName(whatToDo.rFilePrefix, suffix, name);
    sourceFileRefNum := OpenResFile(name);
    IF sourceFileRefNum = -1 THEN
      BEGIN
      fileErrorAlert(ResError, name);
      Exit;
      END;

    r := getResFromCurrentFile('PACK', resIdOwnedByPACK);
    IF r=NIL THEN
      BEGIN
      fileErrorAlert(ResError, name);
      Exit;
      END;
    DetachResource(r);
    HNoPurge(r);
    CloseResFile(sourceFileRefNum);
    IF ResError <> noErr THEN
      fileErrorAlert(ResError, name);

    UseResFile(printerResourceFileRefNum);

    WITH thCodeResourceHeader(r)^^ DO
      BEGIN
        rDeviceId := 3;  {should be 3 ???}
        rVersion := 2;  {???}
        rFlags := $0400E000;  {???}
      END;  {WITH}

    retCode := replaceResource(r, 'PACK', resIdOwnedByPACK, 'Chooser intf', (resPurgeable));
    IF retCode <> noErr THEN
      fileErrorAlert(retCode, whatToDo.rPrinterResourceFile.fName);
  END;  {processPack}


  PROCEDURE installToSystem;
    CONST
      systemFileName= 'System';  {for error messages only}
    VAR
      nameHandle: StringHandle;
  BEGIN
    UseResFile(0);  {System file}
    nameHandle := GetString(resIdOwnedByPDEF);
    IF nameHandle=NIL THEN
      BEGIN
      fileErrorAlert(ResError, systemFileName);
      Exit;
      END;
    SetString(nameHandle, whatToDo.rPrinterResourceFile.fName);
    ChangedResource(Handle(nameHandle));
    IF ResError<>noErr THEN
      BEGIN
      fileErrorAlert(ResError, systemFileName);
      Exit;
      END;
    UpdateResFile(0);  {otherwise changes will be lost at application exit}
    IF ResError<>noErr THEN
      BEGIN
      fileErrorAlert(ResError, systemFileName);
      Exit;
      END;
  END;  {installToSystem}


BEGIN
  InitGraf(@thePort);
  InitFonts;
  FlushEvents(everyEvent, 0);
  InitWindows;
  InitMenus;
  TEInit;
  InitDialogs(NIL);
  InitCursor;

  applicationResFile := CurResFile;
  UseResFile(0);
  actualSystemResFile := CurResFile;
  UseResFile(applicationResFile);

  CouldAlert(fileErrorALRTId);  {make sure alert is always available in memory}
  mainDialog := GetNewDialog(mainDLOGId, NIL, Pointer(-1));
  IF mainDialog=NIL THEN
    Exit;

  REPEAT
    ModalDialog(NIL, itemHit);
    tryToProcessCheckBox(mainDialog, itemHit);
  UNTIL (itemHit=okButton) OR (itemHit=cancelButton);
  IF itemHit=cancelButton THEN
    Exit;

  decodeMainDialogState;  {sets whatToDo record according to dialog settings}
  DisposDialog(mainDialog);

  IF determineFile<>noErr THEN  {sets printer resource file name & volume to whatToDo record}
    Exit;

  retCode := openPrinterResourceFile;
  IF retCode<>noErr THEN  {opens file and sets global RefNum}
    BEGIN
    fileErrorAlert(retCode, whatToDo.rPrinterResourceFile.fName);
    Exit;
    END;

  WITH whatToDo DO
    BEGIN
    IF rDrvr THEN processDrvr('DRVR');
    IF rPdef0 THEN processPdef('PDEF0', 0);
    IF rPdef1 THEN processPdef('PDEF1', 1);
    IF rPdef4 THEN processPdef('PDEF4', 4);
    IF rPdef5 THEN processPdef('PDEF5', 5);
    IF rPack THEN processPack('PACK');
    IF rInstallToSystem THEN installToSystem;
    END;

  CloseResFile(printerResourceFileRefNum);  {changes will be updated}
  IF ResError <> noErr THEN
    fileErrorAlert(ResError, whatToDo.rPrinterResourceFile.fName);

END.